Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Libraries/Bitmap Libraries 2.0/Lisp Interface/BitMapExamples.lisp

Lisp/Scheme | 1996-03-10 | 13KB | 412 lines

;; File BitMapExamples.lisp
;;
;;  Copyright (C) 1994, 1996 by John Montbriand.  All Rights Reserved.
;;
;;  Distribute freely in areas where the laws of copyright apply.
;;
;;  Use at your own risk.
;;
;;  Do not distribute modified copies.
;;
;;  These various BitMap libraries are for free!
;;
;;  See the file BitMap.txt for details.
;;
;; Macintosh Common Lisp Foreign Function Interfaces to the BitMap Libraries

;; BEFORE EVALUATING THIS FILE...
;; [step one]  make sure the files BitMaps.lisp and BitMapsLib.o are in
;; the Library folder in the MCL directory.  Once those files are in place,
;; the BitMaps package can be conveniently used in any program you make.

;; ALSO...
;; Some of the examples herein use the following fonts:
;;   Geneva, New York, Chicago


;; [step two] load and import the package so it can be used here
;; note: normally, these two commands would be included in any
;; program that uses the bitmaps package.

(require :bitmaps)
(use-package :bitmaps)


;; [step three] define a few utility routines used in the examples that follow...

;; simple-window is used in the following to make windows for demonstration
(defun simple-window (width height)
   "for making simple little windows for showing stuff on the screen."
   (make-instance 'window
       :view-position #@(10 50)
       :view-size (make-point width height)
       :window-title "BitMap"
       :window-type :single-edge-box
       :erase-anonymous-invalidations nil))

;; dragonr adapted to lisp from the pascal found in Matthew Zeidenberg's article
;; "Snowflakes and Dragons" appearing in the August 1985 issue of MacWorld (p. 127).
(defun dragonr (x1 y1 x2 y2 x3 y3 n)
   "recursive dragon drawing routine"
   (if (<= n 1)
      (progn
         (#_MoveTo x1 y1)
         (#_LineTo x2 y2)
         (#_LineTo x3 y3))
      (let* ((x4 (truncate (/ (+ x1 x3) 2)))
                (y4 (truncate (/ (+ y1 y3) 2)))
                (x5 (+ x3 (- x2 x4)))
                (y5 (+ y3 (- y2 y4))))
         (dragonr x2 y2 x4 y4 x1 y1 (1- n))
         (dragonr x2 y2 x5 y5 x3 y3 (1- n)))))

(defun dragon-fractal (h v size n)
   (dragonr (+ h size) v h (- v size) (- h size) v n))




;; [example one]  the same drawing commands done directly
;; to the screen.  here, you can see how things get drawn.  Also,
;; some of the bitmap routines are used to draw strings sideways
;; and in different positions.

(prog (wind title-bits rtitle-bits mcl-title bits-title h)

   ;; make a new window
   (setf wind (simple-window 200 200))

   ;; draw into the window
   (with-focused-view wind

       ;; draw the dragon fractal image
       (dragon-fractal 125 110 50 11)

       ;; plot the dragon title
       (setf title-bits (string-to-bitmap "Dragon" '("Chicago" 24)))
       (setf h (truncate (/ (- 200 (get-bitmap-width title-bits)) 2)))
       (plot-bitmap title-bits h 0 #$srcOr)

       ;; plot the MCL III title
       (setf mcl-title (string-to-bitmap "MCL III" '("New York" 36)))
       (setf rtitle-bits (rotate-bitmap-right mcl-title))
       (plot-bitmap rtitle-bits 0 0 #$srcOr)


       ;; plot the BitMaps title
       (setf bits-title (string-to-bitmap "BitMaps" '("Geneva" 36)))
       (setf h (truncate (/ (- 200 (get-bitmap-width bits-title)) 2)))
       (plot-bitmap bits-title h 150 #$srcOr)

       ;; recover the bitmap storage
       (kill-bitmap rtitle-bits title-bits mcl-title bits-title))

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))





;; [example two]  drawing into bitmaps.  Here, the same
;; drawing commands are used to create the image off-screen.
;; in the next example, this function is called before the image
;; is placed on the screen.

;; example of how to draw to an offscreen bitmap.  note, in this
;; example we draw directly into the bitmap using the quickdraw
;; functions called in dragonr, and using the plot-bitmap routine
;; for other bitmaps created using the string-to-bitmap routine
(defun make-dragon-bitmap (&optional n)

   "create a 200 by 200 bitmap containing a dragon fractal"

   (let (my-bitmap title-bits rtitle-bits mcl-title bits-title h)

      ;; create a new bitmap
      (setf my-bitmap (new-bitmap 200 200))

      ;; draw into the bitmap
      (with-focused-bitmap (my-bitmap)

          ;; draw the dragon fractal image
          (dragon-fractal 125 110 50 (if (null n) 8 n))

          ;; plot the dragon title
          (setf title-bits (string-to-bitmap "Dragon" '("Chicago" 24)))
          (setf h (truncate (/ (- 200 (get-bitmap-width title-bits)) 2)))  ;; center it
          (plot-bitmap title-bits h 0 #$srcOr)

          ;; plot the MCL III title
          (setf mcl-title (string-to-bitmap "MCL III" '("New York" 36)))
          (setf rtitle-bits (rotate-bitmap-right mcl-title))
          (plot-bitmap rtitle-bits 0 5 #$srcOr)


          ;; plot the BitMaps title
          (setf bits-title (string-to-bitmap "BitMaps" '("Geneva" 36)))
          (setf h (truncate (/ (- 200 (get-bitmap-width bits-title)) 2))) ;; center it
          (plot-bitmap bits-title h 150 #$srcOr)

          ;; recover the bitmap storage
          (kill-bitmap rtitle-bits title-bits mcl-title bits-title))

      ;; return the bitmap
      my-bitmap))




;; [example three] how to put a bitmap into a window

;; example of how to draw a bitmap in a window
;; here we draw an image on an offscreen bitmap and
;; put the result on the screen.
(prog (my-bitmap wind)

   ;; make a new window
   (setf wind (simple-window 200 200))

   ;; create an image in a bitmap
   (setf my-bitmap (make-dragon-bitmap 11))

   ;; plot the bitmap in the window
   (with-focused-view wind
       (plot-bitmap my-bitmap 0 0 #$srcCopy))

   ;; recover the bitmap storage
   (kill-bitmap my-bitmap)

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))




;; [example four] rotating a bitmap to an arbitrary angle

;; example of how to rotate a bitmap and draw it in a window
;; here we draw an image to an offscreen bitmap, and rotate
;; the image to 36 degrees at a time.
(prog (my-bitmap wind next-bitmap)

   ;; create a window for display
   (setf wind (simple-window 200 200))

   ;; create an image in a bitmap
   (setf my-bitmap (make-dragon-bitmap 11))

   ;; draw into the window
   (with-focused-view wind
       (dotimes (i 11)
          (setf next-bitmap (rotate-bitmap my-bitmap (+ i 100) 100 (* i 36)))
          (plot-bitmap next-bitmap 0 0 #$srcCopy)
          (kill-bitmap next-bitmap)))

   ;; recover the bitmap storage
   (kill-bitmap my-bitmap)

   ;; wait a few seconds
   (sleep 1)

   ;; close the window
   (window-close wind))



;; [example five] logical operations on bitmaps

;; example of how do to a logical operation on bitmaps
;; here we draw an image in a bitmap, make another one
;; containing the image flipped vertically, xor the two
;; together and put the result on the screen.
(prog (my-bitmap wind other-image drawn-image)

   ;; create a window for display
   (setf wind (simple-window 200 200))

   ;; create an image in a bitmap
   (setf my-bitmap (make-dragon-bitmap 11))

   ;; create another image (a frame)
   (setf other-image (new-bitmap 200 200))
   (with-focused-bitmap (other-image)
       (#_PenSize 2 2)
       (#_MoveTo 0 0)
       (#_Line 198 0)
       (#_Line 0 198)
       (#_Line -198 0)
       (#_Line 0 -198)

       (#_MoveTo 150 40)
       (#_TextSize 24)
       (with-pstrs ((initials "JM")) (#_DrawString initials)))

   ;; xor the two images together
   (setf drawn-image (xor-bitmaps other-image my-bitmap))

   ;; plot the result in the window
   (with-focused-view wind
       (plot-bitmap drawn-image 0 0 #$srcCopy))

   ;; recover the bitmap storage
   (kill-bitmap my-bitmap other-image drawn-image)

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))





;; [example six] pixel oriented operations used for drawing

;; example of how to set specific bits in the raster image.
;; here, we a grid (one pixel at a time) every 10 pixels
;; by inverting each pixel value, clearing intersections.
;; the entire image is transfered to the screen once after each line is drawn.
(prog (my-bitmap wind)

   ;; create a window for display
   (setf wind (simple-window 200 200))

   ;; create an image in a bitmap
   (setf my-bitmap (new-bitmap 200 200))

   ;; Put a letter on it
   (with-focused-bitmap (my-bitmap)
       (#_MoveTo 45 175)
       (#_TextSize 200)
       (with-pstrs ((initials "J")) (#_DrawString initials)))

   ;; draw into the window
   (with-focused-view wind
       (do ((x 10 (+ x 10))) ((eq x 200))
          (do ((y 10 (1+ y))) ((eq y 190))

             ;; draw some dots using the pixel functions
             (if (eq (rem y 10) 0)

                ;; clear dots where lines cross
                (clear-bitmap-pixel my-bitmap x y)

                ;; invert pixels in other places
                (progn
                   (toggle-bitmap-pixel my-bitmap x y)
                   (toggle-bitmap-pixel my-bitmap y x))))

          ;; draw to screen at the end of each line
          (plot-bitmap my-bitmap 0 0 #$srcCopy)))

   ;; recover the bitmap storage
   (kill-bitmap my-bitmap)

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))




;; [example seven] drawing in colour with bitmaps

;; example of how to draw in different colours using bitmaps
;; here we draw successive generations of the dragon fractal
;; on the screen in different colours using colouration.
(prog (my-bitmap wind colour-list)

   ;; create a window for display
   (setf wind (simple-window 200 200))

   ;; set up a ring of colours
   (setf colour-list (list *red-color* *green-color* *blue-color* *yellow-color*))
   (setf (cdr (last colour-list)) colour-list)

   ;; start drawing into the window
   (with-focused-view wind

       ;; paint the window black
       (set-fore-color wind *black-color*)
       (#_PaintRect (pref (wptr wind) windowrecord.portrect))

       ;; loop while overlapping successive generations in different colours
       (do ((i 12 (1- i)) (colour colour-list (cdr colour))) ((eq i 0))

          ;; create another image
          (setf my-bitmap (make-dragon-bitmap i))

          ;; set the drawing colour
          (set-fore-color wind (car colour))

          ;; add it to the image on the screen
          (plot-bitmap my-bitmap 0 0 #$srcOr)

          ;; recover the bitmap storage
          (kill-bitmap my-bitmap)))

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))




;; [example eight] drawing strings at different orientations

;; example of how to use string to bitmap for drawing strings
;; in different orientations
(prog (my-bitmap right-bitmap left-bitmap height width wind the-string index hpos)

   ;; create a window for display
   (setf wind (simple-window 200 250))

   ;; draw some rotated strings in the window
   (with-focused-view wind
       (dotimes (i 10)

          ;; create a bitmap containing a string
          (setf index (1+ i))
          (setf the-string (format nil "String ~@R (~R)" index index))
          (setf my-bitmap (string-to-bitmap the-string `("Geneva" 11 :bold)))

          ;; rotate the string image right and left
          (setf left-bitmap (rotate-bitmap-left my-bitmap))
          (setf right-bitmap (rotate-bitmap-right my-bitmap))

          ;; calculate the horizontal position
          (setf width (get-bitmap-width right-bitmap))
          (setf hpos (- (* width 11) (* i width)))

          ;; put the right image at the top of the window
          (plot-bitmap right-bitmap hpos 0 #$srcOr)

          ;; put the left image at the bottom of the window
          (setf height (get-bitmap-height left-bitmap))
          (plot-bitmap left-bitmap hpos (- 250 height) #$srcOr)

          ;; recover the bitmap storage
          (kill-bitmap my-bitmap left-bitmap right-bitmap)))

   ;; wait a few seconds
   (sleep 4)

   ;; close the window
   (window-close wind))


;; end of file BitMapExamples.lisp